perm filename MEM[G,BGB]1 blob
sn#020186 filedate 1973-01-14 generic text, type T, neo UTF8
00100 ;-----------------------------------------------------------------
00200 INTERN OLD44,UNIVER,BLKCNT,AVAIL
00300 OLD44: 0
00400 UNIVER: 0
00500 BLKCNT: 0
00600 AVAIL: 0
00700 REMAINDER:0
00800 NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
00900 SUBR(MORCOR)------------------------------------------------------
01000 BEGIN MORCOR; - GET MORE CORE - BGB - 4 DEC 1972.
01100
01200 ;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
01300 SKIPE OLD44↔GO L1
01400 LAC 1,44↔DAC 1,OLD44
01500 ADDI 1,3↔DAC 1,BLKCNT
01550 ADDI 1,1↔DAC 1,AVAIL↔DAC 1,UNIVER
01800 SETZM REMAINDER
01900
02000 ;FOUR MORE K !
02100 L1: LAC 1,44↔LAC 0,1↔ADDI 0,10000
02200 CALLI 11↔GO[FATAL(NO MORE CORE.)]
02300 AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
02400 SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
02500
02600 ;MAKE AVAIL LIST.
02700 ADDI 1,3↔DIP 1,1↔ADD 1,[XWD NODSIZ,0]
02800 SKIPE@BLKCNT↔GO .+3
02900 ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@BLKCNT ;STEP OVER THE UNIVERSE.
03000 DAPZ 1,@AVAIL
03100 L2: HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
03200 CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
03300 SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03400 LACI 10000↔LAC 1,UNIVER↔ADDM -3(1)
03500 LAC 1,@AVAIL
03600 LAC 2,AC2↔POP0J
03700
03800 BEND;1/12/73------------------------------------------------------
00100 SUBR(MAKE)TYPE----------------------------------------------------
00200 BEGIN MAKE; ALLOCATE A BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
00300 SKIPN 1,@AVAIL↔CALL(MORCOR)
00400 CDR(1)↔DAP @AVAIL
00500 SETZM(1)↔AOS @BLKCNT
00600 POP P,.+3↔POP P,(1)↔GO @.+1↔0
00800 BEND;1/12/73------------------------------------------------------
00900
01000 SUBR(KILL)NODE----------------------------------------------------
01100 BEGIN KILL; - RELEASE BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
01200 LAC 1,ARG1
01300 SKIPN 2(1)↔GO[OUTSTR[ASCIZ/ AN EMPTY NODE KILLED.
01400 /]↔POP1J]↔SOS @BLKCNT
01500 LIPI -3(1)↔LAPI -2(1)↔SETZM -3(1)↔BLT 8(1) ;CLEAR NODE.
01600 LAC @AVAIL↔DAPZ(1)↔DAPZ 1,@AVAIL
01700 POP1J
01800 BEND;1/12/73------------------------------------------------------
01900
02000 SUBR(RINGIN)------------------------------------------------------
02100 BEGIN RINGIN;(PART,WHOLE) RING PART INTO A WHOLE -BGB- 6 DEC 1972.
02200 LAC 1,ARG2
02300 LAC 3,ARG1
02400 ; SON 2,3
02500 ; JUMPE 2,[SON. 1,3↔DIP 1,(1)↔DAP 1,(1)↔POP2J]
02600 CAR 3,(2)
02700 DIP 3,(1)↔DAP 1,(3)
02800 DAP 2,(1)↔DIP 1,(2)
02900 POP2J↔LIT
03000 BEND;1/10/73------------------------------------------------------